Fritz: All Fritz/All Fritz.zip/All Fritz/FILES/GRAPTIES/SD204.LZH/EXAMPLE1.PAS

Pascal/Delphi Source File | 1980-01-01 | 5KB | 181 lines

{======================================================================}
PROGRAM LOAD_FILES;

USES CRT;

TYPE
   Map         = Record
                  ScrCh : Char;
                  ScrAt : Byte;
                  End;

   Screen      = Array[1..25,1..80] of Map;
   AnyStr      = String[80];

VAR
    CS         : Screen absolute $B800:0000;
    MS         : Screen absolute $B000:0000;
    Filenm     : AnyStr;
    TempStr    : AnyStr;
    Color      : Boolean;

{======================================================================}
PROCEDURE Load_ASCII(AFile : AnyStr);
{                                                     }
{ This routine loads an ASCII format file as created  }
{ by BOX onto the screen.                             }
{                                                     }

VAR
    FilevarA   : Text;
    II         : Integer;

BEGIN
      Assign(FilevarA,AFile);
      {$I-} Reset(FilevarA); {$I+}
      If IOresult = 0 then                        {found good file name}
       Begin
        ClrScr;
        For II := 1 to 25 do
        Begin
         Readln(FilevarA,TempStr);
         GoToXY(1,II);
         Write(TempStr);
        End;
        Close(FilevarA);
       End

      Else                                        {couldn't find file  }
        Begin
          GoToXY(1,24);
          Write('ERROR - Could not find file');
        End;

END; {Load_ASCII}

{======================================================================}
PROCEDURE CheckColor;
{                                                     }
{ Checks memory for presence of color adapter card.   }
{ Sets Color to true if the color adapter is present. }
{                                                     }

BEGIN
     If (Mem[0000:1040] and 48) <> 48
        then Color := True
        else Color := False;
END;

{======================================================================}
PROCEDURE Load_MEM(MFile : AnyStr);
{                                                     }
{ This routine loads a memory format file as created  }
{ by BOX directly into the video buffer.  Since a     }
{ memory format file is the same shape as the video   }
{ buffer, all that needs to be done is to move the    }
{ screen into the buffer (CS := LoadScr;)             }
{                                                     }

VAR
    FilevarM   : File;
    LoadScr    : Screen;

BEGIN
      Assign(FilevarM,MFile);
      {$I-} Reset(FilevarM,4000); {$I+}
      If IOresult = 0 then                        {found good file name}
        Begin
        BlockRead(FilevarM,LoadScr,1);
          If Color then CS := LoadScr
                   else MS := LoadScr;
          Close(FilevarM);
        End
      Else                                        {couldn't find file  }
        Begin
          GoToXY(1,24);
          Write('ERROR - Could not find file');
        End;
END; {Load_MEM}

{======================================================================}
PROCEDURE Load_PAK(PFile:AnyStr);
{                                                     }
{ This procedure loads a Packed Format screen created }
{ by BOX.  The Packed format utilizes a run-length    }
{ encoding scheme that must be unpacked.  Each record }
{ in a Packed Format file is three bytes long. Byte 1 }
{ is the run length, i.e. the number of characters to }
{ repeat.  Byte 2 is the character to repeat and      }
{ byte 3 is the attribute of the character.           }
{                                                     }
TYPE
   Pack        = Record
                  PackNm : Byte;  {run length}
                  PackCh : Char;  {repeated character}
                  PackAt : Byte;  {repeated attribute}
                 End;

VAR
    FilevarM   : File;
    LoadScr    : Screen;
    Packbuf    : Array[1..2000] of Pack;
    II,JJ,Sloc,SX,SY,NumRec  : Integer;

BEGIN
   Sloc := 1;              {SLoc is location on screen}
   Assign(FilevarM,PFile);
   {$I-} Reset(FilevarM); {$I+}
   If IOresult = 0 then          {found good file name}
     Begin
        BlockRead(FilevarM,PackBuf,48,NumRec);
        JJ := 0;
        While Sloc < 2001 do
        Begin
          JJ := JJ + 1;
          For II := 1 to Packbuf[JJ].PackNm do
           Begin
            SY := (SLoc-1) div 80 + 1;       {row}
            SX := (SLoc-1) mod 80 + 1;       {column}
            LoadScr[SY,SX].ScrCh := Packbuf[JJ].PackCh;
            LoadScr[SY,SX].ScrAt := Packbuf[JJ].PackAt;
            SLoc := SLoc + 1;
           End;
        End;
        If Color then CS := LoadScr
                 else MS := LoadScr;
        Close(FilevarM);
   End
   Else                            {couldn't find file}
     Begin
       GoToXY(1,24);
       Write('ERROR - Could not find file');
     End;
END;

{======================================================================}
PROCEDURE Pause;
VAR
  Dummy : Char;
Begin
  GoToXY(1,25);
  ClrEol;
  GoToXY(1,25);
  Write('Hit any key to continue');
  Dummy := ReadKey;
End;

{======================================================================}
BEGIN {Main Routine}
  ClrScr;
  Load_ASCII('EXAMPLE1.ASC');
  Pause;

  CheckColor;
  Load_MEM('EXAMPLE1.MEM');
  Pause;

  CheckColor;
  Load_PAK('EXAMPLE1.PAK');
  Pause;
END.